1 Vorbereitung

1.1 Pakete laden

library(tidyverse)

1.2 Daten laden

data("diamonds")

2 Aufgaben

2.1 Werte zuweisen

2.1.1 Problem

  1. Definieren Sie eine Variable “alter” mit dem Wert 42
  2. Definieren Sie eine Variable “name” mit dem Wert “Schorsch”
  3. Definieren Sie eine Variable “schorsch” mit dem Wert “42”

2.1.2 Lösung

alter <- 42  # a
name <- "Schorsch"  # b
schorsch <- "42"  # c
name <- schorsch

2.2 Filtern

2.2.1 Problem

Laden Sie zunächst die Tabelle “diamonds”.

Filtern Sie …

  1. alle Diamanten besten Schliffs.
  2. alle Diamanten mit einem Preis zwischen 1000 und 10000 Dollar.
  3. alle Diamanten mit bester Farbe und bestem Schliff
  4. die 10% teuersten Diamanten.

2.2.2 Lösung

data("diamonds")  # ggplot2, das ist Teil des Tidyverse
diamonds %>% 
  filter(cut == "Ideal")
## # A tibble: 21,551 x 10
##    carat cut   color clarity depth table price     x     y     z
##    <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
##  1  0.23 Ideal E     SI2      61.5    55   326  3.95  3.98  2.43
##  2  0.23 Ideal J     VS1      62.8    56   340  3.93  3.9   2.46
##  3  0.31 Ideal J     SI2      62.2    54   344  4.35  4.37  2.71
##  4  0.3  Ideal I     SI2      62      54   348  4.31  4.34  2.68
##  5  0.33 Ideal I     SI2      61.8    55   403  4.49  4.51  2.78
##  6  0.33 Ideal I     SI2      61.2    56   403  4.49  4.5   2.75
##  7  0.33 Ideal J     SI1      61.1    56   403  4.49  4.55  2.76
##  8  0.23 Ideal G     VS1      61.9    54   404  3.93  3.95  2.44
##  9  0.32 Ideal I     SI1      60.9    55   404  4.45  4.48  2.72
## 10  0.3  Ideal I     SI2      61      59   405  4.3   4.33  2.63
## # … with 21,541 more rows

alle Diamanten mit einem Preis zwischen 1000 und 10000 Dollar.

diamonds %>% 
  filter(price >= 1e3 & price <= 1e4)
## # A tibble: 34,219 x 10
##    carat cut       color clarity depth table price     x     y     z
##    <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
##  1  0.7  Ideal     E     SI1      62.5    57  2757  5.7   5.72  3.57
##  2  0.86 Fair      E     SI2      55.1    69  2757  6.45  6.33  3.52
##  3  0.7  Ideal     G     VS2      61.6    56  2757  5.7   5.67  3.5 
##  4  0.71 Very Good E     VS2      62.4    57  2759  5.68  5.73  3.56
##  5  0.78 Very Good G     SI2      63.8    56  2759  5.81  5.85  3.72
##  6  0.7  Good      E     VS2      57.5    58  2759  5.85  5.9   3.38
##  7  0.7  Good      F     VS1      59.4    62  2759  5.71  5.76  3.4 
##  8  0.96 Fair      F     SI2      66.3    62  2759  6.27  5.95  4.07
##  9  0.73 Very Good E     SI1      61.6    59  2760  5.77  5.78  3.56
## 10  0.8  Premium   H     SI1      61.5    58  2760  5.97  5.93  3.66
## # … with 34,209 more rows
diamonds %>% 
  filter(between(price, 1e03, 1e04))
## # A tibble: 34,219 x 10
##    carat cut       color clarity depth table price     x     y     z
##    <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
##  1  0.7  Ideal     E     SI1      62.5    57  2757  5.7   5.72  3.57
##  2  0.86 Fair      E     SI2      55.1    69  2757  6.45  6.33  3.52
##  3  0.7  Ideal     G     VS2      61.6    56  2757  5.7   5.67  3.5 
##  4  0.71 Very Good E     VS2      62.4    57  2759  5.68  5.73  3.56
##  5  0.78 Very Good G     SI2      63.8    56  2759  5.81  5.85  3.72
##  6  0.7  Good      E     VS2      57.5    58  2759  5.85  5.9   3.38
##  7  0.7  Good      F     VS1      59.4    62  2759  5.71  5.76  3.4 
##  8  0.96 Fair      F     SI2      66.3    62  2759  6.27  5.95  4.07
##  9  0.73 Very Good E     SI1      61.6    59  2760  5.77  5.78  3.56
## 10  0.8  Premium   H     SI1      61.5    58  2760  5.97  5.93  3.66
## # … with 34,209 more rows
  1. alle Diamanten mit bester Farbe und bestem Schliff
diamonds %>% 
  filter(cut == "Ideal", color == "D")
## # A tibble: 2,834 x 10
##    carat cut   color clarity depth table price     x     y     z
##    <dbl> <ord> <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
##  1  0.3  Ideal D     SI1      62.5    57   552  4.29  4.32  2.69
##  2  0.3  Ideal D     SI1      62.1    56   552  4.3   4.33  2.68
##  3  0.71 Ideal D     SI2      62.3    56  2762  5.73  5.69  3.56
##  4  0.71 Ideal D     SI1      61.9    59  2764  5.69  5.72  3.53
##  5  0.71 Ideal D     SI2      61.6    55  2767  5.74  5.76  3.54
##  6  0.76 Ideal D     SI2      62.4    57  2770  5.78  5.83  3.62
##  7  0.73 Ideal D     SI2      59.9    57  2770  5.92  5.89  3.54
##  8  0.75 Ideal D     SI2      61.3    56  2773  5.85  5.89  3.6 
##  9  0.72 Ideal D     SI1      60.8    57  2782  5.76  5.75  3.5 
## 10  0.64 Ideal D     VS1      61.5    56  2787  5.54  5.55  3.41
## # … with 2,824 more rows
  1. die 10% teuersten Diamanten
diamonds %>% 
  slice_max(order_by = price, prop = .1)
## # A tibble: 5,396 x 10
##    carat cut       color clarity depth table price     x     y     z
##    <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
##  1  2.29 Premium   I     VS2      60.8    60 18823  8.5   8.47  5.16
##  2  2    Very Good G     SI1      63.5    56 18818  7.9   7.97  5.04
##  3  1.51 Ideal     G     IF       61.7    55 18806  7.37  7.41  4.56
##  4  2.07 Ideal     G     SI2      62.5    55 18804  8.2   8.13  5.11
##  5  2    Very Good H     SI1      62.8    57 18803  7.95  8     5.01
##  6  2.29 Premium   I     SI1      61.8    59 18797  8.52  8.45  5.24
##  7  2.04 Premium   H     SI1      58.1    60 18795  8.37  8.28  4.84
##  8  2    Premium   I     VS1      60.8    59 18795  8.13  8.02  4.91
##  9  1.71 Premium   F     VS2      62.3    59 18791  7.57  7.53  4.7 
## 10  2.15 Ideal     G     SI2      62.6    54 18791  8.29  8.35  5.21
## # … with 5,386 more rows
d2 <- diamonds %>% 
  mutate(price_percent = percent_rank(price)) %>% 
  filter(price_percent > .9)

d2
## # A tibble: 5,393 x 11
##    carat cut     color clarity depth table price     x     y     z price_percent
##    <dbl> <ord>   <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>         <dbl>
##  1  1.53 Very G… I     VS1      59.3    58  9823  7.5   7.54  4.46         0.900
##  2  3.11 Fair    J     I1       65.9    57  9823  9.15  9.02  5.98         0.900
##  3  1.5  Ideal   I     VS2      60      61  9827  7.39  7.42  4.44         0.900
##  4  1.5  Very G… I     VVS2     63.3    58  9828  7.24  7.21  4.57         0.900
##  5  1.5  Good    I     VS1      57.9    60  9828  7.48  7.44  4.32         0.900
##  6  1.5  Ideal   E     SI1      61.9    57  9828  7.37  7.31  4.54         0.900
##  7  1.5  Premium I     VS1      61.6    59  9828  7.32  7.26  4.49         0.900
##  8  1.52 Premium E     SI2      58.1    60  9831  7.59  7.53  4.39         0.900
##  9  1.08 Ideal   G     IF       62.3    56  9831  6.55  6.59  4.09         0.900
## 10  1.51 Ideal   H     SI1      61.3    56  9833  7.4   7.44  4.55         0.900
## # … with 5,383 more rows

2.3 Zusammenfassen

2.3.1 Problem

  1. Was ist der mittlere Preis der Diamanten?
  2. Der mediane?
  3. die SD?
  4. der IQR?
  5. Was lernen wir daraus, wenn es zwischen Median und MW einen Unterschied gibt?
  6. Kennen Sie einen Weg, viele Statistiken auf einmal zu bekommen? Welchen?
  7. Was ist der mittlere Preis pro Stufe von cut?

2.3.2 Lösung

  1. Was ist der mittlere Preis der Diamanten?
diamonds %>% 
  drop_na(price) %>% 
  summarise(price_m = mean(price))
## # A tibble: 1 x 1
##   price_m
##     <dbl>
## 1   3933.
  1. Der mediane?
diamonds %>% 
  drop_na(price) %>% 
  summarise(price_md = median(price))
## # A tibble: 1 x 1
##   price_md
##      <dbl>
## 1     2401
  1. und d)
diamonds %>% 
  drop_na(price) %>% 
  summarise(price_sd = sd(price),
            price_iqr = IQR(price))
## # A tibble: 1 x 2
##   price_sd price_iqr
##      <dbl>     <dbl>
## 1    3989.     4374.
  1. Was lernen wir daraus, wenn es zwischen Median und MW einen Unterschied gibt?

MW - Md ist prop. zur Schiefe (es gibt Extremwerte)

  1. Kennen Sie einen Weg, viele Statistiken auf einmal zu bekommen? Welchen?
library(skimr)

skim(diamonds)
Data summary
Name diamonds
Number of rows 53940
Number of columns 10
_______________________
Column type frequency:
factor 3
numeric 7
________________________
Group variables None

Variable type: factor

skim_variable n_missing complete_rate ordered n_unique top_counts
cut 0 1 TRUE 5 Ide: 21551, Pre: 13791, Ver: 12082, Goo: 4906
color 0 1 TRUE 7 G: 11292, E: 9797, F: 9542, H: 8304
clarity 0 1 TRUE 8 SI1: 13065, VS2: 12258, SI2: 9194, VS1: 8171

Variable type: numeric

skim_variable n_missing complete_rate mean sd p0 p25 p50 p75 p100 hist
carat 0 1 0.80 0.47 0.2 0.40 0.70 1.04 5.01 ▇▂▁▁▁
depth 0 1 61.75 1.43 43.0 61.00 61.80 62.50 79.00 ▁▁▇▁▁
table 0 1 57.46 2.23 43.0 56.00 57.00 59.00 95.00 ▁▇▁▁▁
price 0 1 3932.80 3989.44 326.0 950.00 2401.00 5324.25 18823.00 ▇▂▁▁▁
x 0 1 5.73 1.12 0.0 4.71 5.70 6.54 10.74 ▁▁▇▃▁
y 0 1 5.73 1.14 0.0 4.72 5.71 6.54 58.90 ▇▁▁▁▁
z 0 1 3.54 0.71 0.0 2.91 3.53 4.04 31.80 ▇▁▁▁▁
  1. Was ist der mittlere Preis pro Stufe von cut?
diamonds %>% 
  group_by(cut) %>% 
  summarise(price_avg = mean(price))
## # A tibble: 5 x 2
##   cut       price_avg
##   <ord>         <dbl>
## 1 Fair          4359.
## 2 Good          3929.
## 3 Very Good     3982.
## 4 Premium       4584.
## 5 Ideal         3458.

2.4 Sortieren

2.4.1 Problem

Sortieren Sie den Datensatz nach Preis und zeigen Sie die Top-3-Diamanten (hinsichtlich der max. Höhe des Preises)!

2.4.2 Lösung

diamonds %>% 
  arrange(-price) %>%   # alternativ: desc(price)
  slice(1:3)
## # A tibble: 3 x 10
##   carat cut       color clarity depth table price     x     y     z
##   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1  2.29 Premium   I     VS2      60.8    60 18823  8.5   8.47  5.16
## 2  2    Very Good G     SI1      63.5    56 18818  7.9   7.97  5.04
## 3  1.51 Ideal     G     IF       61.7    55 18806  7.37  7.41  4.56
diamonds %>% 
  slice_max(price, n = 3)
## # A tibble: 3 x 10
##   carat cut       color clarity depth table price     x     y     z
##   <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>
## 1  2.29 Premium   I     VS2      60.8    60 18823  8.5   8.47  5.16
## 2  2    Very Good G     SI1      63.5    56 18818  7.9   7.97  5.04
## 3  1.51 Ideal     G     IF       61.7    55 18806  7.37  7.41  4.56

2.5 Mutieren

2.5.1 Problem

  1. Erstellen Sie eine Variable, die die Größenordnung des Preises angibt:
  • dreistelliger Preis (100-999) -> Wert ist 2 -> log10(100) = 2
  • vierstelliger Preis (1000-9999) -> Wert ist 3
  • etc.
  1. Berechnen Sie eine Art “Volumen” des Diamanten, in dem Sie x, y und z multiplizieren.
  2. Erstellen Sie eine Variable, die angibt, ob der Preis des Diamanten größer als der Mittelwert ist.
  3. Berechnen Sie die Korrelation von Volumen und Gewicht (carat).

2.5.2 Lösung

log10(100) == 2
## [1] TRUE
log10(1000) == 3
## [1] TRUE
log10(1e4) == 4  # 10000 = 10^4 
## [1] TRUE

:-)

diamonds <-
  diamonds %>% 
  mutate(preis_log10 = log10(price))

In diesem Fall wäre es nicht so gut mit case_when zu arbeiten:

diamonds %>% 
  mutate(price_oom = case_when(
    price > 100 & price < 1000 ~ 2,
    price < 10000 ~ 3,
    TRUE ~ NA_real_
  ))
## # A tibble: 53,940 x 12
##    carat cut       color clarity depth table price     x     y     z preis_log10
##    <dbl> <ord>     <ord> <ord>   <dbl> <dbl> <int> <dbl> <dbl> <dbl>       <dbl>
##  1  0.23 Ideal     E     SI2      61.5    55   326  3.95  3.98  2.43        2.51
##  2  0.21 Premium   E     SI1      59.8    61   326  3.89  3.84  2.31        2.51
##  3  0.23 Good      E     VS1      56.9    65   327  4.05  4.07  2.31        2.51
##  4  0.29 Premium   I     VS2      62.4    58   334  4.2   4.23  2.63        2.52
##  5  0.31 Good      J     SI2      63.3    58   335  4.34  4.35  2.75        2.53
##  6  0.24 Very Good J     VVS2     62.8    57   336  3.94  3.96  2.48        2.53
##  7  0.24 Very Good I     VVS1     62.3    57   336  3.95  3.98  2.47        2.53
##  8  0.26 Very Good H     SI1      61.9    55   337  4.07  4.11  2.53        2.53
##  9  0.22 Fair      E     VS2      65.1    61   337  3.87  3.78  2.49        2.53
## 10  0.23 Very Good H     VS1      59.4    61   338  4     4.05  2.39        2.53
## # … with 53,930 more rows, and 1 more variable: price_oom <dbl>
diamonds <-
  diamonds %>% 
  mutate(volume = x * y * z)
diamonds <- 
  diamonds %>% 
  mutate(price_high = case_when(  # ifelse würde auch gehen
    price > mean(price) ~ TRUE,
    TRUE ~ FALSE
  ))
diamonds %>% 
  count(price_high)
## # A tibble: 2 x 2
##   price_high     n
##   <lgl>      <int>
## 1 FALSE      34283
## 2 TRUE       19657
diamonds %>% 
  select(carat, volume) %>% 
  cor()  #Input: Eine Tabelle mit nur numerischen Spalten
##            carat    volume
## carat  1.0000000 0.9763084
## volume 0.9763084 1.0000000

2.6 Log-Transformation

2.6.1 Problem

  1. Welche Hypothese finden Sie am plausibelsten? Begründen Sie!

    • Steigt das Gewicht des Diamanten um 1 Gramm, so steigt der Preis (im Schnitt) um \(b\) Dollar?
    • Steigt das Gewicht des Diamanten um 1 Gramm, so steigt der Preis (im Schnitt) um \(b\) Prozent?
    • Steigt das Gewicht des Diamanten um 1 Prozent, so steigt der Preis (im Schnitt) um \(b\) Prozent?

  2. Betrachten Sie den Zusammenhang von Preis und Gewicht und prüfen Sie, ob Sie den Zusammenhang durch eine Log-Transformation linearisieren können.

  3. Vielleicht hilft auch eine andere Art von Transformation (um den Zusammenhang zu linearisieren)? Probieren Sie es aus!

2.6.2 Lösung

2.6.2.1 a)

Hyp.1 : Die Hypothese impliziert, dass der Preiszuwachs von 1 auf 2 Karat zum gleichen Preiszuwachs führt wie die Erhöhung von 2 auf 3 Karat (unter sonst gleichen Umständen).

Die Daten unterstützen das nicht:

diamonds %>% 
  mutate(carat_rounded = round(carat)) %>% 
  group_by(carat_rounded) %>% 
  summarise(mean(price))
## # A tibble: 6 x 2
##   carat_rounded `mean(price)`
##           <dbl>         <dbl>
## 1             0          840.
## 2             1         4163.
## 3             2        12196.
## 4             3        15369.
## 5             4        15715.
## 6             5        18018

Aber bleiben wir für Erste bei einer theoretischen Erörterung.

Hyp 2: “Steigt das Gewicht des Diamanten um 1 Gramm, so steigt der Preis (im Schnitt) um \(b\) Prozent?”

Dieses Wachstumsmuster nennt man auch exponenzielles Wachstum und ist sehr häufig bei allen Wachstumsprozessen, macht aber hier nicht unbedingt viel Sinn (könnte aber trotzdem die Daten passabel beschreiben, sollten wir gleich mal ausprobieren).

Hyp3: “Steigt das Gewicht des Diamanten um 1 Prozent, so steigt der Preis (im Schnitt) um \(b\) Prozent?”

Überlegen wir mal, wie Karat mit dem Preis zusammenhängt. Sachwissen (und eine EDA) zeigt, dass Karat der zentrale Treiber (und Ursache?) des Preises ist. Karat ist ein Form, das Gewicht zu messen: Ein Karat sind 0.2 Gramm. Das Gewicht (Karat; \(c\)) ist eine Funktion des Volumen und Volument ist eine Funktion von Länge, Breite und Höhe (x,y,z): \(c =f(x,y,z\)). Einige Momente ruhiges Nachdenken zeigen, dass solche Zusammenhänge eine Potenzfunktion darstellen. Potenzfunktionien haben stets das Wachstumsmuster wie in Hypothese 3 aufgeführt. Diese “Theorie” spricht sich also für die Stichhaltigkeit von Hypothese 3 aus. Das sollten wir gleich mal an den Daten überprüfen!

2.6.2.2 b)

Ohne Transformation:

diamonds %>% 
  filter(carat < 2.5) %>%  # bleiben >50000 übrig
  ggplot() +
  aes(x = carat, y = price) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

Mit Log-Transformation:

diamonds %>% 
  filter(carat < 2.5) %>% 
  ggplot() +
  aes(x = carat, y = log(price)) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

diamonds %>% 
  filter(carat < 2.5) %>% 
  ggplot() +
  aes(x = log(carat), y = log(price)) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

2.6.2.3 c)

diamonds %>% 
  filter(carat < 2.5) %>% 
  ggplot() +
  aes(x = carat, y = sqrt(price)) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

diamonds %>% 
  filter(carat < 2.5) %>% 
  ggplot() +
  aes(x = log(carat), y = price^(1/3)) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

diamonds %>% 
  filter(carat < 2.5) %>% 
  ggplot() +
  aes(x = carat, y = price^(1/3)) +
  geom_hex() +
  geom_smooth() +
  geom_smooth(method = "lm", color = "red")
## `geom_smooth()` using method = 'gam' and formula 'y ~ s(x, bs = "cs")'
## `geom_smooth()` using formula 'y ~ x'

2.7 Regressionsgüte nach Transformationen

Vergleichen Sie die Vorhersagegüte von Modellen, die den Preis anhand des Gewichts vorhersagen.

2.7.1 Lösung

lm1 <- lm(price ~ carat, data = diamonds %>% filter(carat < 2.5))
plot(lm1)

summary(lm1)$r.squared
## [1] 0.8520234
lm2 <- lm(log(price) ~ carat, data = diamonds %>% filter(carat != 0))
plot(lm2)

summary(lm2)$r.squared
## [1] 0.8467802
lm3 <- lm(log(price) ~ log(carat), data = diamonds)
plot(lm3)

summary(lm3)$r.squared
## [1] 0.9329893

2.8 Fehlende Werte zählen

  1. Wie viele fehlenden Werte gibt es in der Tabelle?
  2. … in der Spalte price?
  3. … in jeder einzelnen Spalte?

2.9 Korrelationen mit Preis visualisieren